home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
bufferio.zip
/
BUFFERIO.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-01-04
|
7KB
|
263 lines
UNIT BufferIO;
{ BufferIO version 0.9: BETA! This unit may or may not work. }
{ This program is released into the public domain by its author (me) }
{ Bruce Feist. }
{ However, I respectfully request the following: }
{ If you redistribute it, please clearly indicate what changes you have }
{ made (if any). Please don't delete or alter this notice, either. }
{ And, please include all other materials that you received with it }
{ (a documentation file and a driver program to test it). Also, please }
{ do NOT include any compiled code. JUST include the .PAS files and }
{ documentation. That should make it harder to infect with any viruses! }
{ Anyway, please contact me, Bruce Feist, on Compuserve with any bug }
{ reports, enhancement requests, or general suggestions. My ID is }
{ 71320,3635; you can reach me on the BPROGA forum. }
{ I hope this proves useful to you all. }
{ *************** }
{ BufferIO Unit Description }
{ Purpose: }
{ This unit buffers reads done to any untyped file with a record length }
{ of 1. The buffer size used is 9K. }
{ Usage: }
{ Just put a USES clause for the unit into any program or unit which }
{ you want to buffer the reads on. Make sure that ALL units referring to }
{ the file have the USES, otherwise you'll have problems. }
{ Compatability: }
{ BufferIO has been tested under TP 5.5. It should work on all }
{ versions of TP from 4.0 up. }
INTERFACE
USES DOS;
TYPE
TByteArray = ARRAY [0 .. MaxInt] OF byte;
PByteArray = ^TByteArray;
TBuffFileRec =
RECORD
Handle: Word;
Mode: Word;
RecSize: Word;
Private: ARRAY[1 .. 26] OF byte;
BufferPtr: PByteArray;
BufferPos: Word;
UsedBytes: Word;
BufferSize: Word;
ReqRecSize: Word;
Dirty: Boolean;
UserData: ARRAY [1 .. 3] OF byte;
Name: ARRAY[0 .. 79] OF char;
END; { TBuffFileRec }
PROCEDURE ReSet (VAR FileID: FILE; OpenRecSize: Word);
PROCEDURE ReWrite (VAR FileID: FILE; OpenRecSize: Word);
PROCEDURE Close (VAR FileID: FILE);
PROCEDURE BlockRead (VAR FileID: FILE; VAR Buf; Count: Word; VAR Result: Word);
PROCEDURE BlockWrite (VAR FileID: FILE; VAR Buf; Count: Word; VAR Result: Word);
PROCEDURE Seek (VAR FileID: FILE; n: longint);
FUNCTION FilePos (VAR FileID: FILE): longint;
FUNCTION EOF (VAR FileID: FILE): Boolean;
IMPLEMENTATION
CONST
BuffSize = 9 * 1024; { 1 diskette track }
FUNCTION Min (x, y: word): word;
BEGIN { min }
IF x > y
THEN Min := y
ELSE Min := x
END; { Min }
PROCEDURE BFlush (VAR FileID: FILE);
BEGIN { BFlush }
WITH TBuffFileRec(FileID) DO
BEGIN
Dirty := FALSE;
END; { WITH }
END; { BFlush }
PROCEDURE ReSet (VAR FileID: FILE; OpenRecSize: Word);
BEGIN { ReSet }
System.ReSet (FileID, OpenRecSize);
IF OpenRecSize = 1 THEN
WITH TBuffFileRec(FileID) DO
BEGIN
Writeln ('Opened for buffered reading!');
GetMem (BufferPtr, BuffSize);
BufferSize := BuffSize;
UsedBytes := 0;
BufferPos := 0;
ReqRecSize := OpenRecSize;
Dirty := False;
END; { WITH }
END; { ReSet }
PROCEDURE ReWrite (VAR FileID: FILE; OpenRecSize: Word);
BEGIN { ReWrite }
System.ReWrite (FileID, 1);
IF OpenRecSize = 1 THEN
WITH TBuffFileRec(FileID) DO
BEGIN
Writeln ('Opened for buffered writing!');
GetMem (BufferPtr, BuffSize);
BufferSize := BuffSize;
UsedBytes := 0;
BufferPos := 0;
ReqRecSize := OpenRecSize;
Dirty := False;
END; { WITH }
END; { ReWrite }
PROCEDURE Close (VAR FileID: FILE);
BEGIN { Close }
IF TBuffFileRec (FileID).ReqRecSize = 1 THEN
BEGIN
BFlush (FileID);
WITH TBuffFileRec (FileID) DO
BEGIN
FreeMem (BufferPtr, BufferSize);
BufferSize := 0;
UsedBytes := 0;
BufferPos := 0;
END; { WITH }
END; { IF ReqRecSize }
System.Close (FileID);
END; { Close }
PROCEDURE BlockRead (VAR FileID: FILE; VAR Buf; Count: Word; VAR Result: Word);
CONST
FirstTime: Boolean = True;
VAR
SoFar, BytesFromBuff, ReqBytes: Word;
BEGIN { BlockRead }
WITH TBuffFileRec(FileID) DO
IF ReqRecSize = 1 THEN
BEGIN
IF FirstTime THEN
BEGIN
Writeln ('First buffered read');
FirstTime := False;
END;
ReqBytes := count * ReqRecSize;
BytesFromBuff := min (ReqBytes, UsedBytes - BufferPos);
Move (BufferPtr^[BufferPos], Buf, BytesFromBuff);
Inc (BufferPos, BytesFromBuff);
SoFar := BytesFromBuff;
IF Dirty THEN
BEGIN
BFlush (FileID);
END;
WHILE SoFar < ReqBytes DO
BEGIN
IF Dirty
THEN BFlush (FileID);
System.BlockRead (FileID, BufferPtr^, BufferSize, UsedBytes);
BytesFromBuff := min (ReqBytes - SoFar, UsedBytes);
Move (BufferPtr^, PByteArray(@Buf)^[SoFar], BytesFromBuff);
BufferPos := BytesFromBuff;
Inc (SoFar, BytesFromBuff);
END { WHILE SoFar }
END { IF ReqRecSize }
ELSE
System.BlockRead (FileID, Buf, Count, Result);
END; { BlockRead }
PROCEDURE BlockWrite (VAR FileID: FILE; VAR Buf; Count: Word; VAR Result: Word);
CONST
FirstTime: Boolean = True;
BEGIN { BlockWrite }
WITH TBuffFileRec (FileID) DO
IF ReqRecSize = 1 THEN
BEGIN
IF FirstTime THEN
BEGIN
Writeln ('First Buffered Write');
FirstTime := False;
END;
System.Seek (FileID, System.FilePos(FileID) + BufferPos);
System.BlockWrite (FileID, Buf, Count, Result);
TBuffFileRec(FileID).Dirty := True;
BufferPos := 0;
UsedBytes := 0;
END
ELSE
System.BlockWrite (FileID, Buf, Count, Result);
END; { BlockWrite }
PROCEDURE Seek (VAR FileID: FILE; n: longint);
BEGIN { Seek }
WITH TBuffFileRec (FileID) DO
IF ReqRecSize = 1 THEN
BEGIN
BFlush (FileID);
System.Seek (FileID, n);
BufferPos := 0;
UsedBytes := 0;
END
ELSE
System.Seek (FileID, n);
END; { Seek }
FUNCTION FilePos (VAR FileID: FILE): longint;
VAR
Result: Longint;
BEGIN { FilePos }
WITH TBuffFileRec (FileID) DO
IF ReqRecSize = 1 THEN
BEGIN
Result := System.FilePos (FileID)
- UsedBytes + TBuffFileRec(FileID).BufferPos;
END
ELSE
Result := System.FilePos (FileID);
FilePos := Result;
END; { FilePos }
FUNCTION EOF (VAR FileID: FILE): boolean;
VAR
Result: Boolean;
BEGIN { EOF }
WITH TBuffFileRec (FileID) DO
IF ReqRecSize = 1 THEN
Result := (BufferPos >= UsedBytes) AND System.EOF(FileID)
ELSE
Result := System.EOF(FileID);
EOF := Result;
END; { EOF }
BEGIN { BufferIO }
END. { BufferIO }